home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / V / lsp / numlib.lsp < prev    next >
Lisp/Scheme  |  1992-04-11  |  4KB  |  143 lines

  1. Changes file for /usr/local/src/kcl/lsp/numlib.lsp
  2. Created on Sat Apr 11 09:20:43 1992
  3. Usage \n@s[Original text\n@s|Replacement Text\n@s]
  4. See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
  5. for a program to merge change files.  Anything not between
  6. "\n@s[" and  "\n@s]" is a simply a comment.
  7. This file was constructed using emacs and  merge.el
  8. Enhancements Copyright (c) W. Schelter All rights reserved.
  9.    by (Bill Schelter)  wfs@carl.ma.utexas.edu 
  10.  
  11.  
  12. ****Change:(orig (29 29 c))
  13. @s[(defconstant imag-one #C(0.0s0 1.0s0))
  14.  
  15. @s|(defconstant imag-one #C(0.0d0 1.0d0))
  16.  
  17. @s]
  18.  
  19.  
  20. ****Change:(orig (64 65 c))
  21. @s[                              (sqrt (- 1.0s0 (* x x)))))))))
  22.             (if (and (not (complexp x)) (zerop (imagpart c)))
  23.  
  24. @s|                              (sqrt (- 1.0d0 (* x x)))))))))
  25.             (if (or (not (complexp x)) (zerop (imagpart c)))
  26.  
  27. @s]
  28.  
  29.  
  30. ****Change:(orig (72 73 c))
  31. @s[                                   (sqrt (- 1.0s0 (* x x))))))))))
  32.             (if (and (not (complexp x)) (zerop (imagpart c)))
  33.  
  34. @s|                                   (sqrt (- 1.0d0 (* x x))))))))))
  35.             (if (or (not (complexp x)) (zerop (imagpart c)))
  36.  
  37. @s]
  38.  
  39.  
  40. ****Change:(orig (77 78 c))
  41. @s[(defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0s0))
  42. (defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0s0))
  43.  
  44. @s|(defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0d0))
  45. (defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0))
  46.  
  47. @s]
  48.  
  49.  
  50. ****Change:(orig (81 81 c))
  51. @s[(defun asinh (x) (log (+ x (sqrt (+ 1.0s0 (* x x))))))
  52.  
  53. @s|(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x))))))
  54.  
  55. @s]
  56.  
  57.  
  58. ****Change:(orig (87 87 c))
  59. @s[       (when (or (= x 1.0s0) (= x -1.0s0))
  60.  
  61. @s|       (when (or (= x 1.0d0) (= x -1.0d0))
  62.  
  63. @s]
  64.  
  65.  
  66. ****Change:(orig (91 91 c))
  67. @s[       (log (/ (1+ x) (sqrt (- 1.0s0 (* x x))))))
  68.  
  69. @s|       (log (/ (1+ x) (sqrt (- 1.0d0 (* x x))))))
  70.  
  71. @s]
  72.  
  73.  
  74. ****Change:(orig (95 98 c))
  75. @s[       (multiple-value-bind (i e s) (integer-decode-float x)
  76.         (if (>= s 0)
  77.             (* i (expt (float-radix x) e))
  78.             (- (* i (expt (float-radix x) e))))))
  79.  
  80. @s|  (etypecase x
  81.     (float      
  82.       (multiple-value-bind (i e s) (integer-decode-float x)
  83.                (if (>= s 0)
  84.                    (* i (expt (float-radix x) e))
  85.                  (- (* i (expt (float-radix x) e))))))
  86.     (rational x)))
  87.  
  88. @s]
  89.  
  90.  
  91. ****Change:(orig (100 100 a))
  92. @s[
  93.  
  94.  
  95. @s|
  96.  
  97. (setf (symbol-function 'rationalize) (symbol-function 'rational))
  98.  
  99. ;; although the following is correct code in that it approximates the
  100. ;; x to within eps, it does not preserve (eql (float (rationalize x) x) x)
  101. ;; since the test for eql is more strict than the float-epsilon
  102.  
  103.  
  104. @s]
  105.  
  106.  
  107. ****Change:(orig (103 127 c))
  108. @s[(defun rationalize (x)
  109.   (typecase x
  110.     (rational x)
  111.     (short-float (rationalize-float x short-float-epsilon))
  112.  
  113. @s,                  (/ num den)))))))
  114.  
  115. @s|;(defun rationalize (x)
  116. ;  (typecase x
  117. ;    (rational x)
  118. ;    (short-float (rationalize-float x short-float-epsilon 1.0s0))
  119. ;    (long-float (rationalize-float x long-float-epsilon 1.0d0))
  120. ;    (otherwise (error "~S is neither rational nor float." x))))
  121. ;
  122. ;(defun rationalize-float (x eps one)
  123. ;  (cond ((minusp x) (- (rationalize (- x))))
  124. ;        ((zerop x) 0)
  125. ;        (t (let ((y ())
  126. ;                 (a ()))
  127. ;             (do ((xx x (setq y (/ one
  128. ;                                   (- xx (float a x)))))
  129. ;                  (num (setq a (truncate x))
  130. ;                       (+ (* (setq a (truncate y)) num) onum))
  131. ;                  (den 1 (+ (* a den) oden))
  132. ;                  (onum 1 num)
  133. ;                  (oden 0 den))
  134. ;                 ((and (not (zerop den))
  135. ;                       (not (> (abs (/ (- x (/ (float num x)
  136. ;                                               (float den x)))
  137. ;                                       x))
  138. ;                               eps)))
  139. ;                  (/ num den)))))))
  140.  
  141. @s]
  142.  
  143.